COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "FOURSOME"
C00010 ENDMK
C⊗;
BEGIN "FOURSOME";
DEFINE ⊂="BEGIN",⊃="END",$="COMMENT";
DEFINE BOARDS="6",PLAYERS="16";
INTEGER ARRAY SET,SET1,SET2[0:16,0:6];	$ Trial, initial and adopted arrays;
INTEGER ARRAY HIT,HIT1,HIT2[0:16,0:16];
INTEGER ARRAY NONO,NONO1,NONO2,NONO3[0:16,0:16];
INTEGER H,I,I2,J,K,K2,L,M,M2,N,N2,P,Q,R,T,U,V,W,X;
INTEGER CHAN,HITMAX,HITNUM,HITMA2,HITNU2,HITSUM,HITSUM2;
STRING TALLY;
CHAN←1;
FOR J←1 STEP 1 UNTIL 6 DO
⊂ "JJ"
  T←J; U←0;   OUTSTR('15&'12&"J="&CVS(J)&'15&'12);
  FOR I←1 STEP 1 UNTIL 16 DO
  ⊂ "II"
    IF SET[I,J]>0 THEN CONTINUE "II";
    HITSUM←256;
    T←T-1;  IF T=0 THEN T←4; IF T>4 THEN T←T-4;
    OUTSTR("   T="&CVS(T));
    SET[I,J]←(T LSH 27);
    ARRTRAN(SET1,SET); ARRTRAN(HIT1,HIT);	$ Save to restore for LL trials;
    ARRTRAN(NONO1,NONO);		$ Save for conclusion of LL trials;
FOR L←1 STEP 1 UNTIL 15 DO		$ To minimize HITS;
⊂ "LL"
      FOR K←1 STEP 1 UNTIL 16 DO
      ⊂ "KK"
        IF SET[K,J]>0 THEN CONTINUE "KK";
        IF NONO[I,K]=0 THEN DONE "KK";
      ⊃ "KK";
      IF K>16 THEN DONE "LL";
      NONO[I,K]←NONO[K,I]←1;
      ARRTRAN(NONO3,NONO);	$ Save for next LL trial
      HITMA2←HITMAX;  HITNU2←HITNUM;
    SET[I,J]←SET[I,J]+(K LSH 18);  SET[K,J]←(T LSH 27)+(I LSH 18);
    FOR Q←0 STEP 1 UNTIL 6 DO
    ⊂ "QQ"
      FOR M←16 STEP -1 UNTIL 1 DO
      ⊂ "MM"
        IF SET[M,J]>0 THEN CONTINUE "MM";
        IF HIT[I,M]+HIT[J,M]≤Q THEN DONE "QQ";
      ⊃ "MM";
    ⊃ "QQ";
    IF Q>6 THEN
    ⊂ ARRTRAN(SET,SET1);  ARRTRAN(HIT,HIT1);	$ Restore and repeat with a new K;
      ARRTRAN(NONO,NONO3);
      CONTINUE "LL";  ⊃;
    HIT[I,M]←HIT[I,M]+1;	HIT[K,M]←HIT[K,M]+1;
    HIT[M,I]←HIT[M,I]+1;	HIT[M,K]←HIT[M,K]+1;
    IF Q>HITMAX THEN HITMAX←Q;  IF Q>0 THEN HITNUM←HITNUM+1;
    SET[I,J]←SET[I,J]+M LSH 9;  SET[K,J]←SET[K,J]+M LSH 9;
    SET[M,J]←(T LSH 27)+(I LSH 9)+K;
    FOR R←0 STEP 1 UNTIL 6 DO
    ⊂ "RR"
      FOR N←1 STEP 1 UNTIL 16 DO
      ⊂ "NN"
        IF NONO[M,N]>0 THEN CONTINUE "NN";
        IF SET[N,J]>0 THEN CONTINUE "NN";
        IF HIT[I,N]+HIT[K,N]≤R THEN DONE "RR";
      ⊃ "NN";
    ⊃ "RR";
    IF R>6 THEN
    ⊂ ARRTRAN(SET,SET1);  ARRTRAN(HIT,HIT1);	$ Restore and repeat with a new K;
      ARRTRAN(NONO,NONO3);
      CONTINUE "LL";  ⊃;
    IF R>HITMAX THEN HITMAX←R;  IF R>0 THEN HITNUM←HITNUM+1;
    NONO[M,N]←NONO[N,M]←1;
    SET[I,J]←SET[I,J]+N;	SET[K,J]←SET[K,J]+N;
    SET[M,J]←SET[M,J]+N LSH 18;
    SET[N,J]←(T LSH 27)+(M LSH 18)+(I LSH 9)+K;
    HIT[I,N]←HIT[I,N]+1;	HIT[K,N]←HIT[K,N]+1;
    HIT[N,I]←HIT[N,I]+1;	HIT[N,K]←HIT[N,K]+1;
    X←0;
    FOR V←1 STEP 1 UNTIL 16 DO
      FOR W←1 STEP 1 UNTIL 16 DO
        IF HIT[V,W]>0 THEN X←X+HIT[V,W]-1;
    IF X<HITSUM THEN
    ⊂ HITSUM←X;			$ Save best LL try to date;
      ARRTRAN(SET2,SET);   ARRTRAN(HIT2,HIT);
      I2←I; K2←K; M2←M; N2←N;	$ Save these instead of NONO2, and fix NONO later;
    ⊃ ;
    IF X=0 THEN DONE "LL";
    ARRTRAN(SET,SET1);		$ Restore initial contitions for next try;
    ARRTRAN(HIT,HIT1);
    ARRTRAN(NONO,NONO3);	$ Use 3 to prevent repeat on K;
⊃ "LL";
    OUTSTR(" "&CVS(I2)&","&CVS(K2)&","&CVS(M2)&","&CVS(N2)&" H="&CVS(HITSUM));
  ARRTRAN(SET,SET2);		$ Reset for best LL try;
  ARRTRAN(HIT,HIT2);
  ARRTRAN(NONO,NONO1);		$ Must go back to this and fix it;
  NONO[I2,K2]←NONO[M2,N2]←NONO[K2,I2]←NONO[N2,M2]←1;
  ⊃ "II";
⊃ "JJ";
OUTSTR('15&'12&"MAX HIT = "&CVS(HITMAX)&" NUM HITS = "&CVS(HITNUM));
TALLY←"\|\\M1CORON;\M2BDI40;\M3NGR40;";
P←0;
FOR I←1 STEP 1 UNTIL 16 DO
⊂ "III"
  TALLY←TALLY&"\F1	Player No. "
&CVS(I)&'11&"Name"&'15&'12&'15&'12&"\F2Round	Table		With		Score"&'15&'12;
  FOR J←1 STEP 1 UNTIL 6 DO
  ⊂ "JJJ"
    T←LDB(POINT(9,SET[I,J],8));
    K←LDB(POINT(9,SET[I,J],17));
    TALLY←TALLY&CVS(J)&'11&'11&CVS(T)&'11&'11&CVS(K)&'15&'12;
  ⊃ "JJJ";
  TALLY←TALLY&"\F3"&'11&'11&'11&'11&'11&"Total"&'15&'12&'15&'12&'15&'12;
  P←P+1;  IF P=3 THEN
   ⊂ P←0;  TALLY←TALLY&'14; ⊃ ELSE  TALLY←TALLY&'15&'12&'15&'12&'15&'12;
⊃ "III";
TALLY←TALLY&CVS(HITNUM)&" opponent duplications with a maximum of "&CVS(HITMAX);
CLOSE(CHAN); OPEN(CHAN,"DSK",0,0,2,0,0,0); 
ENTER(CHAN,"TALLY[ALS,ALS]",0);
OUT(CHAN,TALLY); CLOSE(CHAN);
⊃ "FOURSOME";